home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG10.ZIP / 3DGEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-22  |  2.4 KB  |  95 lines
  1. Program Gen3d;
  2.  
  3. Uses Crt;
  4.  
  5.  
  6. Const MaxPoints=200;
  7.       MaxLines=200;
  8.  
  9. Type Point3d=Record
  10.                    X,Y,Z:Integer;
  11.              End;
  12.  
  13.      Object3d=Record
  14.                     NumberPoints:Byte;
  15.                     NumberLines:Byte;
  16.                     Pt:Array[1..MaxPoints] Of Point3d;
  17.                     Ln:Array[1..MaxLines,1..2] Of Byte;
  18.               End;
  19.  
  20. Var Obj:Object3d;
  21.     Pts:Byte;
  22.     Lns:Byte;
  23.     A:Byte;
  24.     Filename:String;
  25.     F:Text;
  26.  
  27. Begin
  28.      ClrScr;
  29.      TextColor(Yellow);
  30.      Writeln('«««««««««««««««««««««««««««««««««««« 3D GEN »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»');
  31.      Writeln;
  32.      TextColor(LightCyan);
  33.      Writeln('                                 By Spellcaster');
  34.      Writeln;
  35.      TextColor(LightGreen);
  36.      Writeln('Number of points in object (Max=',MaxPoints,') ?');
  37.      TextColor(LightRed);
  38.      Readln(Pts);
  39.      If Pts>MaxPoints Then Exit;
  40.      Writeln;
  41.      TextColor(LightGreen);
  42.      Writeln('Number of lines in object (Max=',MaxLines,') ?');
  43.      TextColor(LightRed);
  44.      Readln(Lns);
  45.      If Lns>MaxLines Then Exit;
  46.      Writeln;
  47.      TextColor(LightGreen);
  48.      Writeln('Type in points...');
  49.      TextColor(LightRed);
  50.      For A:=1 To Pts Do
  51.      Begin
  52.           TextColor(LightGreen);
  53.           Writeln('Point number ',A);
  54.           Writeln('X,Y,Z ?');
  55.           TextColor(LightRed);
  56.           Readln(Obj.Pt[A].X,Obj.Pt[A].Y,Obj.Pt[A].Z);
  57.      End;
  58.      Writeln;
  59.      TextColor(LightGreen);
  60.      Writeln('Type in lines...');
  61.      TextColor(LightRed);
  62.      For A:=1 To Lns Do
  63.      Begin
  64.           TextColor(LightGreen);
  65.           Writeln('Line number ',A);
  66.           Writeln('Point1,Point2 ?');
  67.           TextColor(LightRed);
  68.           Readln(Obj.Ln[A,1],Obj.Ln[A,2]);
  69.      End;
  70.      Writeln;
  71.      TextColor(LightGreen);
  72.      Write('Name of file:');
  73.      TextColor(LightCyan);
  74.      ReadLn(Filename);
  75.      Writeln('Saving data...');
  76.      Assign(F,Filename);
  77.      ReWrite(F);
  78.      WriteLn(F,Pts);
  79.      WriteLn(F,Lns);
  80.      For A:=1 To Pts Do
  81.      Begin
  82.           WriteLn(F,Obj.Pt[A].X);
  83.           WriteLn(F,Obj.Pt[A].Y);
  84.           WriteLn(F,Obj.Pt[A].Z);
  85.      End;
  86.      For A:=1 To Lns Do
  87.      Begin
  88.           WriteLn(F,Obj.Ln[A,1]);
  89.           WriteLn(F,Obj.Ln[A,2]);
  90.      End;
  91.      Close(F);
  92.      TextColor(LightGreen);
  93.      Writeln('Done...');
  94.      Readln;
  95. End.